perm filename PALIN2.PAS[S1,ALS] blob
sn#478124 filedate 1979-10-02 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 (* $A+,D+*)
C00008 ENDMK
Cā;
(* $A+,D+*)
program PALINDROME(OUTPUT);
const NUMMAX = 3; PALMAX = 74; NUMLIM = 5; PALLIM = 75;
var I, J, N, NUMVAL, PALVAL, CARRY : integer;
NUM : array [1..NUMLIM] of integer;
PAL,PAL2 : array [1..PALLIM] of integer;
begin
writeln (OUTPUT,
'Additions Palindrome');
writeln (TTY,
'Additions Palindrome');
for I := 1 TO PALMAX do PAL[I] := 0;
for I := 1 to NUMMAX do NUM[I] := 0;
NUM [1] := 6; NUM [2] := 9; NUM[3] := 1; NUMVAL := 3; (* Initial conditions*)
PALVAL := NUMVAL;
N := 0;
for I := 1 to NUMVAL do PAL[I] := NUM[I];
for I := NUMVAL + 1 TO PALMAX do PAL[I] := 0;
while PALVAL <= PALMAX do
begin (* while PALVAL <= PALMAX*)
I := 1; J := PALVAL;
while ((PAL[I] = PAL [J]) and (I < J)) do
begin
I := I + 1; J := J - 1;
end;
if I < J then (* Not a palindrome*)
begin
write (OUTPUT,N:4,' ');
for I := PALVAL + 1 to PALMAX do write (OUTPUT,' ');
for I := PALVAL downto 1 do write (OUTPUT,PAL[I]:1);
writeln (OUTPUT);
write (TTY,N:4,' ');
for I := PALVAL + 1 to PALMAX do write (TTY,' ');
for I := PALVAL downto 1 do write (TTY,PAL[I]:1);
writeln (TTY); BREAK;
J := PALVAL; CARRY := 0;
for I := 1 to PALVAL do
begin
PAL2[I] := PAL[I] + PAL[J] + CARRY;
if PAL2[I] > 9 then
begin
PAL2[I] := PAL2[I] - 10; CARRY := 1;
end
else CARRY := 0;
J := J - 1;
end;
if CARRY = 1 then
begin
PALVAL := PALVAL +1;
PAL2[PALVAL] := 1;
CARRY := 0;
end;
if PALVAL = PALMAX + 1 then
begin
for I := NUMVAL + 1 to NUMMAX do
begin
write ( OUTPUT,' ');
write ( TTY,' ');
end;
for I := NUMVAL downto 1 do
begin
write (OUTPUT, NUM[I]:1);
write (TTY, NUM[I]:1);
end;
writeln (OUTPUT,' NOT FOUND in ',N:4,' additions to ',
PALLIM:2,' CHARACTERS.');
writeln (TTY,' NOT FOUND in ',N:4,' additions to ',
PALLIM:2,' CHARACTERS.'); BREAK;
end
else
begin
for I := 1 to PALVAL do PAL[I] := PAL2[I];
N := N +1;
end;
end (* Not a palindrome*)
else if N <= 9 then PALVAL := PALLIM (* Don't bother to print*)
else
begin (* A palindrome has been found*)
for I := NUMVAL + 1 to NUMMAX do
begin
write ( OUTPUT,' ');
write ( TTY,' ');
end;
for I :=NUMVAL downto 1 do
begin
write (OUTPUT, NUM[I]:1);
write (TTY, NUM[I]:1);
end;
write (OUTPUT,N:5);
write (TTY,N:5);
for I := PALVAL + 1 to PALMAX do
begin
write ( OUTPUT,' ');
write ( TTY,' ');
end;
for I := PALVAL downto 1 do
begin
write (OUTPUT, PAL[I]:1);
write (TTY, PAL[I]:1);
end;
writeln (OUTPUT);
writeln ( TTY); BREAK;
PALVAL := PALMAX +1; (* To effect exit from while PALVAL < PALMAX*)
end (* a palindrome has been found*);
end (* while PALVAL <= PALMAX*);
CARRY := 1;
for I := 1 to NUMVAL do
begin
NUM[I] := NUM[I] +CARRY;
if NUM[I] > 9 then
begin
NUM[I] := NUM[I] - 10;
CARRY := 1;
end
else CARRY := 0;
end;
end.